(add-to-load-path (dirname (current-filename)))

(use-modules
 (ice-9 textual-ports)
 (ice-9 regex)
 (decode)
 (email)
 (web server)
 (web request)
 (web response)
 (web uri)
 (oop goops)
 (sxml simple)
 ;; (srfi srfi-19)
 )

(define* (templatize title body
                     #:key
                     (js-files #f))
  `(html (head (title ,title)
               (head
                (link (@ (type "text/css") (href "css/form.min.css") (rel "stylesheet")) "")
                ,(if js-files
                     `(script (@ (async) (src ,(string-append "js/" js-files))) " ")
                     `(link (@ (type "text/css") (href "#")) ""))
                )
               (body ,@body))
         ))

(define* (respond #:optional body #:key
                  (status 200)
                  (title "form")
                  (doctype "<!DOCTYPE html>\n")
                  (content-type-params '((charset . "utf-8")))
                  (content-type 'text/html)
                  (extra-headers '())
                  (js-files #f)
                  (sxml (and body (if js-files
                                      (templatize title body #:js-files js-files)
                                      (templatize title body)))))
  (values (build-response
           #:code status
           #:headers `((content-type
                        . (,content-type ,@content-type-params))
                       ,@extra-headers))
          (lambda (port)
            (if sxml
                (begin
                  (if doctype (display doctype port))
                  (sxml->xml sxml port))))))

(define (request-path-components request)
  (split-and-decode-uri-path (uri-path (request-uri request))))

;; Paste this in your REPL
(define (not-found request)
  (values (build-response #:code 404)
          (string-append "Resource not found: "
                         (uri->string (request-uri request)))))

(define (output-file file-name)
  (call-with-input-file file-name
    (lambda (port)
      (string-append
       ""
       (let loop ([string (get-line port)])
         (if (eof-object? string)
             ""
             (string-append
              string "\n" (loop (get-line port)))))))))

(define (submit-page bv)
  (respond
   `((div (@ (class "container"))
          (div (@ (class "row"))
               (div (@ (class "col-md-12"))
                    ,(let* ([alist (decode bv)]
                            ;;(if (and (not null? (assoc-ref alist "timestamp"))))
                            ;; [form-timestamp-pair
                            ;;  (string-split (car (assoc-ref alist "timestamp")) #\space)]
                            ;; [form-timestamp-seconds (car form-timestamp-pair)]
                            ;; [form-timestamp-microseconds (car (cdr form-timestamp-pair))]
                            ;; [timestamp (gettimeofday)]
                            ;; [timestamp-seconds (car timestamp)]
                            ;; [timestamp-microseconds (cdr timestamp)]
                            ;; [form-completion-time-seconds
                            ;;  (- (current-time) (string->number form-timestamp-seconds))]
                            ;; [form-completion-time-microseconds
                            ;;  (abs (- timestamp-microseconds
                            ;;          (string->number form-timestamp-microseconds)))]
                            [name     (car (assoc-ref alist "name"))]
                            [phone    (car (assoc-ref alist "phone"))]
                            [domain   (car (assoc-ref alist "domain"))]
                            [email    (car (assoc-ref alist "email"))]
                            [message  (car (assoc-ref alist "message"))]
                            [honeypot (car (assoc-ref alist "address"))]
                            [service1 (if (assoc-ref alist "service1")
                                          (car (assoc-ref alist "service1"))
                                          #f)]
                            [service2 (if (assoc-ref alist "service2")
                                          (car (assoc-ref alist "service2"))
                                          #f)]
                            [service3 (if (assoc-ref alist "service3")
                                          (car (assoc-ref alist "service3"))
                                          #f)]
                            [service4 (if (assoc-ref alist "service4")
                                          (car (assoc-ref alist "service4"))
                                          #f)]
                            [service5 (if (assoc-ref alist "service5")
                                          (car (assoc-ref alist "service5"))
                                          #f)]
                            [service6 (if (assoc-ref alist "service6")
                                          (car (assoc-ref alist "service6"))
                                          #f)]
                            [service7 (if (assoc-ref alist "service7")
                                          (car (assoc-ref alist "service7"))
                                          #f)]
                            [service8 (if (assoc-ref alist "service8")
                                          (car (assoc-ref alist "service8"))
                                          #f)]
                            ;;[service9 (car (assoc-ref alist "service9"))]
                            [service9 (if (assoc-ref alist "service9")
                                          (car (assoc-ref alist "service9"))
                                          #f)]
                            )
                       ;; if this form was completed in under 200000 microseconds, then this may be a computer trying to log in
                       ;; don't let them log in.  OR if the honeypot had any value in it...
                       ;; (if (or (and (= 0 form-completion-time-seconds)
                       ;;              (> 200000 form-completion-time-microseconds))
                       ;;         (not (string= honeypot "")))
                       ;;     '(p "We're having issues...please try again later."))
                       ;; ,(string-append
                       ;;   "It took you "
                       ;;   ;;(number->string form-completion-time-seconds)
                       ;;   " seconds and "
                       ;;   ;;(number->string form-completion-time-microseconds)
                       ;;   " microseconds to complete the form.\n")

                       (if (string= honeypot "")
                           (begin
                             (send-email email "Hosting at GNUcode.me"
                                         (string-append
                                          "You have decided to use
some of the services provided by gnucode.me! Josh will contact you
will the payment details, and we'll have your services set up in no time."))
                             (send-email "jbranso+services@dismail.de"
                                         (string-append "GNUcode.me Supporter:" name)
                                         (string-append name " wants to host their site :"
                                                        domain
                                                        " with you! Their number is "
                                                        phone
                                                        ".\nTheir email is "
                                                        email
                                                        ".\n"
                                                        "Their message is:\n"
                                                        message
                                                        "Their services are:"
                                                        service1 "\n"
                                                        service2 "\n"
                                                        service3 "\n"
                                                        service4 "\n"
                                                        service5 "\n"
                                                        service6 "\n"
                                                        service7 "\n"
                                                        service8 "\n"
                                                        service9 "\n"
                                                        ))
                             `(p "Awesome! You'll be getting an email
from me soon!  I'm glad that you are looking forward to supporting me!"))
                           `(p "You must be a robot.")))
                    ))))))

(define (main-page)
  (respond
   `((form (@ (action "submit.scm") (method "post"))
           (div
            (label (@ (for "name")) "Name")
            (input (@ (id "name") (type "text") (name "name") (placeholder "Greg Jones"))))
           (div
            (label (@ (for "email")) "Email")
            (input (@ (id "email") (type "email") (name "email") (placeholder "email@example.com"))))
           (div
            ;; this is a honeypot.  It's an hidden input, that users will leave empty, but computer programs
            ;; will put in a value.
            (label (@ (for "address") (class "hidden")) "address")
            (input (@ (id "address") (type "text") (class "hidden") (name "address"))))
           (div
            (label (@ (for "timestamp") (class "hidden")) "timestamp")
            (input (@ (id "timestamp") (type "number") (class "hidden") (name "timestamp")
                      (value ,(string-append
                               (number->string (car (gettimeofday)))
                               " "
                               (number->string (cdr (gettimeofday))))
                             ))))
           (div
            (label (@ (id "phone") (for "phone")) "Phone")
            (input (@ (type "tel") (name "phone") (placeholder "224-930-0493"))))
           (div
            (label (@ (id "subject") (for "subject")) "Subject")
            (input (@ (type "text") (name "subject") (placeholder "Website Hosting"))))
           (div
            (label (@ (id "domain") (for "domain")) "Domain")
            (input (@ (type "text") (name "domain") (placeholder "gregsblog.com"))))
           (div
            (label (@ (id "message") (for "message")) "Message")
            (textarea (@ (name "message") (cols "26") (rows "6")
                         (placeholder "Will you host my website?"))
                      ;;necessary to properly close <textarea></textarea> tag.
                      ()))
           (div
            (button (@ (type "submit")) "Submit"))))))

(define (run-page request body)
  ;;(display (request-path-components request))
  (let ([current-page (request-path-components request)])
    (cond
     [(equal? current-page '("form" "css" "form.min.css"))
      (values `((content-type . (text/css)))
              (output-file "css/form.min.css"))]
     [(equal? current-page '("form" "index.scm"))
      (main-page)]
     [(equal? current-page '("form" "submit.scm"))
      (submit-page body)]
     [else
      (respond `((h1 "Page not found.")
                 (h1 ,(let loop ([current-page current-page])
                        (if (null? current-page) ""
                            (string-append (car current-page) "/"
                                           (loop (cdr current-page))))))
                 (h2 ,current-page)))])))

(run-server run-page 'http '(#:port 8081))
